Cracking 2/Cracking II..iso/Texty/crackme/CHCMKG.BAS

BASIC Source File | 1999-01-04 | 5.8 KB | 153 lines

ECLARE SUB hextodec (hexx$, sum&)             'Declares function to convert HEX to DECIMAL
DECLARE SUB hexi (hex1$, hex2$, hex3$, op$)    'Declares function for some HEX math functions
croatia1998$ = CHR$(49) + CHR$(57) + CHR$(57) + CHR$(56) + " " + CHR$(67) + CHR$(114) + CHR$(111) + CHR$(97) + CHR$(116) + CHR$(105) + CHR$(97)         '"1998 Croatia"
hotmail$ = CHR$(64) + CHR$(104) + CHR$(111) + CHR$(116) + CHR$(109) + CHR$(97) + CHR$(105) + CHR$(108) + CHR$(46) + CHR$(99) + CHR$(111) + CHR$(109)    '"Hotmail.com"
Borna$ = CHR$(66) + CHR$(111) + CHR$(114) + CHR$(110) + CHR$(97) ' "Borna" *** This is inteaded encrypting program, you can't          ***
Janes$ = CHR$(74) + CHR$(97) + CHR$(110) + CHR$(101) + CHR$(115) ' "Janes" *** change my name just editing program with ascii editor ;)***
name$ = ""
COLOR 15
PRINT "               Cruahead CrackMe V1.0  KeyGen "                      'Print
COLOR 14
PRINT "               By " + Borna$ + " " + Janes$ + " " + croatia1998$    'logo of
PRINT "              Email - " + Borna$ + Janes$ + hotmail$                'the program
PRINT "        ------------------------------------------"
6 name$ = "": COLOR 7: PRINT "User name:  "; : COLOR 22: LOCATE CSRLIN, POS(0) - 1: PRINT "█";   'Print "User name:"

DO                           'This is routine for input user name
i$ = INKEY$
IF NOT i$ = "" THEN
i% = ASC(i$)
SELECT CASE i%
 CASE 13               'If ENTER hited then continue
 COLOR 0, 0: COLOR 15
 REM LOCATE CSRLIN, POS(0) - 1: PRINT " "
 EXIT DO
     CASE 27           'If Esc hited then exit
     COLOR 0, 0: LOCATE CSRLIN, POS(0) - (LEN(name$) + 2): PRINT SPACE$(LEN(name$) + 2): COLOR 7, 0: END
     CASE 8            'If backspace hited then delete last char of name
     IF NOT name$ = "" THEN
     name$ = MID$(name$, 1, LEN(name$) - 1)
     LOCATE CSRLIN, POS(0) - 2: PRINT "  ";
     LOCATE CSRLIN, POS(0) - 2
     COLOR 22:  PRINT "█"; : COLOR 0, 0
     END IF
     CASE IS > 31      'I hited any other char add it to name
   IF NOT LEN(name$) >= 10 THEN              'Maximum lenght of name(10)
   COLOR 15: name$ = name$ + i$: LOCATE CSRLIN, POS(0) - 1: PRINT i$;
   COLOR 22: PRINT "█"; : COLOR 0, 0
   END IF
 CASE ELSE
END SELECT
END IF
LOOP

er% = 0                              'Search
FOR lop% = 1 TO LEN(name$)           'the
lett% = ASC(MID$(name$, lop%, 1))    'name    -Name
SELECT CASE lett%                    'for     -can
CASE 56 TO 90                        'any     -containing
CASE 97 TO 122                       'other   -only
CASE ELSE                            'char    -letters
er% = 1                              'beside
END SELECT                           'the
NEXT lop%                            'letter

IF er% = 1 THEN      'If found then display error
LOCATE CSRLIN, 12 + LEN(name$): PRINT " "
LOCATE CSRLIN, 1: COLOR 15: PRINT "Name can containing only letters (no spaces,numbers...)!";  'OVDJE PROMJENIT KOLKO NAJMANJE SLOVA MOZE IMAT IME(one,two)!!
SLEEP 2: LOCATE CSRLIN, 1: PRINT SPACE$(60);
COLOR 0, 0: LOCATE CSRLIN - 1, 1: PRINT SPACE$(77); : COLOR 7, 0
LOCATE CSRLIN, 1: GOTO 6
END IF


IF LEN(name$) < 1 THEN            'If lenght of name is less then one then display error
LOCATE CSRLIN, 12 + LEN(name$): PRINT " "
LOCATE CSRLIN, 1: COLOR 15: PRINT "Name must be the least one character long!";
SLEEP 2: LOCATE CSRLIN, 1: PRINT SPACE$(50);
LOCATE CSRLIN - 1, 12: PRINT "  "; : LOCATE CSRLIN, 1: GOTO 6
END IF
LOCATE CSRLIN, POS(0) - 1: PRINT " "

GOSUB genser               'Call subroutine "GenSer" to generate serial

COLOR 7: PRINT "Serial number: "; : COLOR 15: PRINT ser$     'Print correct serial
COLOR 15: PRINT "Enjoy!!"
COLOR 7: PRINT "": PRINT "Press any key to continue!"
DO: LOOP UNTIL INKEY$ <> ""
END


genser:     'Routine that generates correct serial number
HEXNAME$ = ""                         'Clear HexName$
name$ = UCASE$(name$)                 'Name = Name in uppercase
FOR NAM% = 1 TO LEN(name$)                                           'HexName$ = Sum of
CALL hexi(HEXNAME$, HEX$(ASC(MID$(name$, NAM%, 1))), HEXNAME$, "+")  'all characters
NEXT NAM%                                                            'of name(in HEX)
REM PRINT HEXNAME$
CALL hexi(HEXNAME$, "5678", xoredname$, "xor")                       'XoredName$ = HexName$ XOR "5678"
CALL hexi(xoredname$, "1234", serial$, "xor")                        'Serial$ = XoredName$ XOR "1234"
CALL hextodec(serial$, ser&)                                         'Serial number = Ascii value of Serial$
ser$ = LTRIM$(STR$(ser&))
RETURN                     'Return(RET)
'--------------------------------------END OF CODE-------------------------------------------

SUB hexi (hex1$, hex2$, hex3$, op$)
CALL hextodec(hex1$, sum1&)
CALL hextodec(hex2$, sum2&)
SELECT CASE op$
CASE ">"
hex3$ = HEX$(sum1& >= sum2&)
CASE "xor"
hex3$ = HEX$(sum1& XOR sum2&)
CASE "-"
hex3$ = HEX$(sum1& - sum2&)
CASE "+"
hex3$ = HEX$(sum1& + sum2&)
CASE "*"
hex3$ = HEX$(sum1& * sum2&)
CASE "/"
hex3$ = HEX$(sum1& / sum2&)
END SELECT
END SUB

SUB hextodec (hexx$, sum&)

i$ = UCASE$(hexx$)
br% = 0
nn% = LEN(i$)
header& = 16

FOR i% = nn% TO 1 STEP -1
br% = br% + 1
IF br% >= 3 THEN header& = header& * 16
IF i% = LEN(i$) THEN
il$ = MID$(i$, LEN(i$), 1)
SELECT CASE ASC(il$)
CASE 48 TO 57
sum& = sum& + (ASC(il$) - 48)
 CASE 65 TO 70
 sum& = sum& + ((ASC(il$) - 65) + 10)
END SELECT

ELSE
Char$ = MID$(i$, i%, 1)
IF i% = LEN(i$) THEN
SELECT CASE ASC(il$)
CASE 48 TO 57
sum& = sum& + (ASC(il$) - 48)
 CASE 65 TO 70
 sum& = sum& + ((ASC(il$) - 65) + 10)
END SELECT
END IF
SELECT CASE ASC(Char$)
CASE 48 TO 57
sum& = sum& + ((ASC(Char$) - 48) * header&)
CASE 65 TO 70
sum& = sum& + (((ASC(Char$) - 65) + 10) * header&)
END SELECT
END IF
NEXT i%
END SUB